home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / EDITORS / COLORCTL.ZIP;1 / SETCLR.PRG < prev    next >
Encoding:
Text File  |  1991-10-30  |  8.7 KB  |  168 lines

  1. *      Program: SETCLR.PRG
  2. *       Author: George E. McMullen
  3. *             : Borland Technical Support
  4. *         Date: 10-18-91
  5. *     Function: Utilizes COLORCTL.BIN to custom set dBASE's color settings.
  6. *               This program gives you access to select 16 of 264,000+ possible
  7. *               colors on a VGA monitor.
  8. * Requirements: COLORCTL.BIN
  9. *               VGA color monitor
  10.  
  11. * Setup Environment
  12. gl_escape=IIF(SET("ESCAPE")="ON","ON","OFF")
  13. SET ESCAPE OFF
  14. gl_talk=IIF(SET("TALK")="ON","ON","OFF")
  15. SET TALK OFF
  16. gl_echo=IIF(SET("ECHO")="ON","ON","OFF")
  17. SET ECHO OFF
  18. gl_status=IIF(SET("STATUS")="ON","ON","OFF")
  19. SET STATUS OFF
  20. gl_cursor=IIF(SET("CURSOR")="ON","ON","OFF")
  21. SET CURSOR OFF
  22. gl_color=SET("ATTRIBUTE")
  23. SET COLOR TO W+/N                      && Set color to bright white/black
  24. CLEAR                                  && Clear screen
  25. IF .NOT. FILE("colorctl.bin")          && Check for colorctl.bin
  26.   SET COLOR TO &gl_color               && Reset environment and display error
  27.   SET CURSOR &gl_cursor
  28.   SET STATUS &gl_status
  29.   ? CHR(7)+"Error: Could not locate COLORCTL.BIN"
  30.   SET ESCAPE &gl_escape
  31.   SET ECHO &gl_echo
  32.   SET TALK &gl_talk
  33.   RETURN
  34. ENDIF
  35. PUBLIC ARRAY gl_colors[16,4]           && Public color array string
  36. DECLARE gl_colors[16,4]                && Initial color settings
  37. PUBLIC gl_dcolor                       && Dbase color setttings
  38. gl_dcolor="  N  B  G GB  R RB GR  W N+ B+ G+GB+ R+RB+GR+ W+"
  39. pv_index=1                             && Current index (color) number + 1
  40. pv_disp_color=""                       && Sample color display
  41. pv_new_color=""                        && New color setting
  42. pv_count1=1                            && Restore color index counter
  43. DO storedefaults                       && Get factory default settings
  44. LOAD colorctl.bin                      && Load colorctl.bin into memory
  45. CALL colorctl WITH '/R'                && Reset Default Settings
  46. DO draw_screen                         && Draw display screen
  47. DO WHILE .T.                           && Main loop
  48.   DO CASE                              && Check for last key press
  49.     CASE LASTKEY()=4                   && <right arrow> Increase Index
  50.       pv_index=pv_index+IIF(pv_index=16,-15,1)
  51.     CASE LASTKEY()=19                  && <left arrow> Decrease Index
  52.       pv_index=pv_index-IIF(pv_index>1,1,-15)
  53.     CASE LASTKEY()=26                  && <home> Increase Red Gun
  54.       gl_colors[pv_index,2]=gl_colors[pv_index,2]+;
  55.                             IIF(gl_colors[pv_index,2]<63,1,-63)
  56.     CASE LASTKEY()=2                   && <end> Decrease Red Gun
  57.       gl_colors[pv_index,2]=gl_colors[pv_index,2]-;
  58.                             IIF(gl_colors[pv_index,2]>0,1,-63)
  59.     CASE LASTKEY()=5                   && <up arrow> Increase Green Gun
  60.       gl_colors[pv_index,3]=gl_colors[pv_index,3]+;
  61.                             IIF(gl_colors[pv_index,3]<63,1,-63)
  62.     CASE LASTKEY()=24                  && <down arrow> Decrease Green Gun
  63.       gl_colors[pv_index,3]=gl_colors[pv_index,3]-;
  64.                             IIF(gl_colors[pv_index,3]>0,1,-63)
  65.     CASE LASTKEY()=18                  && <pgup> Increase Blue Gun
  66.       gl_colors[pv_index,4]=gl_colors[pv_index,4]+;
  67.                             IIF(gl_colors[pv_index,4]<63,1,-63)
  68.     CASE LASTKEY()=3                   && <pgdn> Decrease Blue Gun
  69.       gl_colors[pv_index,4]=gl_colors[pv_index,4]-;
  70.                             IIF(gl_colors[pv_index,4]>0,1,-63)
  71.     CASE LASTKEY()=27                  && <ESC> key exit program
  72.       CALL colorctl WITH '/R'          && Reset Factory settings
  73.       EXIT                             && Exit Main Loop
  74.     CASE LASTKEY()=23                  && <ctrl-end> Save colors and exit
  75.       SET SAFE OFF                     && Set safety off
  76.       SAVE TO color ALL LIKE gl_colors && Save array gl_color to file color.mem
  77.       SET SAFE ON                      && Set safety on
  78.       EXIT                             && Exit without resetting colors
  79.     CASE LASTKEY()=29                  && <ctrl-home> Restore colors
  80.       IF FILE("color.mem")             && If COLOR.MEM exists...
  81.         RESTORE FROM color ADDITIVE    && Restore colors from color.mem
  82.         pv_count1=1                    && Restore index countere
  83.         DO WHILE pv_count1<17          && While index number < 17
  84.                                        && Build colorctl command
  85.           pv_new_color='"Index='+STR(gl_colors[pv_count1,1],2)+'",'+;
  86.                        '"Red='  +STR(gl_colors[pv_count1,2],2)+'",'+;
  87.                        '"Green='+STR(gl_colors[pv_count1,3],2)+'",'+;
  88.                        '"Blue=' +STR(gl_colors[pv_count1,4],2)+'"'
  89.           CALL colorctl WITH '/S',&pv_new_color  && Set new index color
  90.           pv_count1=pv_count1+1        && Increment index number
  91.         ENDDO
  92.       ENDIF
  93.   ENDCASE
  94.                                        && Build colorctl command
  95.   pv_new_color='"Index='+STR(gl_colors[pv_index,1],2)+'",'+;
  96.                '"Red='  +STR(gl_colors[pv_index,2],2)+'",'+;
  97.                '"Green='+STR(gl_colors[pv_index,3],2)+'",'+;
  98.                '"Blue=' +STR(gl_colors[pv_index,4],2)+'"'
  99.   CALL colorctl WITH '/S',&pv_new_color  && Set new index color
  100.   SET COLOR TO W+/N                    && Set color to bright white/black
  101.   @ 10,31 TO 16,51 DOUBLE              && Draw sample edit box
  102.   @ 11,32 SAY "Index:"+STR(gl_colors[pv_index,1],3)
  103.   @ 13,32 SAY "Red:  "+STR(gl_colors[pv_index,2],3)
  104.   @ 14,32 SAY "Green:"+STR(gl_colors[pv_index,3],3)
  105.   @ 15,32 SAY "Blue: "+STR(gl_colors[pv_index,4],3)
  106.   @ 11,44 TO 15,50 COLOR
  107.   pv_disp_color=SUBSTR(gl_dcolor,((pv_index-1)*3)+1,3)  && Get selected index
  108.   SET COLOR TO &pv_disp_color          && Display color box
  109.   @ 12,45 SAY REPL(CHR(219),5)
  110.   @ 13,45 SAY REPL(CHR(219),5)
  111.   @ 14,45 SAY REPL(CHR(219),5)
  112.   CLEAR TYPEAHEAD                      && Clear typeahead keyboard buffer
  113.   READ                                 && Wait for keypress
  114. ENDDO
  115. RELEASE colorctl                       && Release colorctl.bin from memory
  116. SET COLOR TO &gl_color                 && Reset environment
  117. SET CURSOR &gl_cursor
  118. SET ECHO &gl_echo
  119. SET TALK &gl_talk
  120. SET ESCAPE &gl_escape
  121. SET STATUS &gl_status
  122. RETURN                                 && EOF() setclr.prg
  123.  
  124. PROCEDURE draw_screen                  && draw display screen procedure
  125. pv_count1=0                            && Index counter
  126. pv_box_color=""                        && Current box color
  127. DO WHIL pv_count1<16                   && While index number < 15
  128.   pv_box_color=SUBSTR(gl_dcolor,(pv_count1*3)+1,3)  && Get new box color
  129.   SET COLO TO W+/n                     && Set text color to bright white/black
  130.   @ 0,0 SAY "Color Index Number:"      && Draw display screen
  131.   @ 1,(pv_count1*5)+2 SAY STR(pv_count1,2)
  132.   @ 2,(pv_count1*5)+1 SAY SUBS(gl_dcolor,(pv_count1*3)+1,3)
  133.   @ 3,0 SAY REPL(CHR(205),80)
  134.   @ 6,0 SAY REPL(CHR(205),80)
  135.   SET COLOR TO &pv_box_color/n         && Set color for box
  136.   @ 4,pv_count1*5 SAY REPL(CHR(219),5) && Draw colored boxes
  137.   @ 5,pv_count1*5 SAY REPL(CHR(219),5)
  138.   pv_count1=pv_count1+1                && Increment index number
  139. ENDDO
  140.                                        && Draw control panel
  141. @ 19,0 SAY "Control Keys:    COLOR SELECTION     RED GUN     GREEN GUN    BLUE GUN"
  142. @ 20,0 SAY "                =================    ========  =============  ========="
  143. @ 21,0 SAY "                left/right arrows    Home/End  Up/Down arrow  PgUp/PgDn"
  144. @ 23,0 SAY "                      <CTRL-END> to save colors to file COLOR.MEM"
  145. @ 24,0 SAY "                     <CTRL-HOME> to load colors from file COLOR.MEM"
  146. RETURN
  147.  
  148. PROCEDURE storedefaults                && Store factory default color values
  149. * pv_default = "index number,red value,green value,blue value,index number,..."
  150. pv_default="00,00,00,00,01,00,00,42,02,00,42,00,03,00,42,42,04,42,00,00,"+;
  151.            "05,42,00,42,06,42,21,00,07,42,42,42,08,21,21,21,09,21,21,63,"+;
  152.            "10,21,63,21,11,21,63,63,12,63,21,21,13,63,21,63,14,63,63,21,"+;
  153.            "15,63,63,63"
  154. pv_count1=0                            && Index counter 0 - 15
  155. pv_count2=0                            && Element counter
  156. DO WHILE pv_count1<16                  && While index number < 16
  157.   pv_count2=0                          && Start at element 0 (index numeber)
  158.   DO WHILE pv_count2<4                 && While elements < 4
  159.                                        && Store the default settings into
  160.                                        &&   the global array gl_color
  161.     gl_colors[pv_count1+1,pv_count2+1]=;
  162.       VAL(SUBSTR(pv_default,(pv_count1*12)+1+(pv_count2*3),2))
  163.     pv_count2=pv_count2+1              && Increment the element counter
  164.   ENDDO
  165.   pv_count1=pv_count1+1                && Increment the index number
  166. ENDDO
  167. RETURN
  168.